home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SORT_UTL / SORTIN / SORTING.PAS < prev    next >
Pascal/Delphi Source File  |  1988-12-25  |  4KB  |  157 lines
  1. unit Sorting;
  2. {=============================================}
  3. {            James L. Allison                 }
  4. {            1703 Neptune Lane                }
  5. {            Houston, Texas  77062            }
  6. {            Dec 22, 1988                     }
  7. {=============================================}
  8.  
  9. { Please feel free to use any part of this in any of your programs.}
  10.  
  11. interface
  12.    uses TypeSpec;
  13. type
  14.    Item=TypeSpec.Character;   {This defines the objects being sorted.}
  15.    List=array [0..0] of Item; {This is an array of objects to be sorted.}
  16.  
  17.    L_Less_Than_R = function(L,R:Item):boolean;
  18. {  This is a user defined function that determines the
  19.    order of the sort.  It may be as simple or complex as
  20.    necessary to give the desired order.  In particular it
  21.    can use any field in a record as the sort key, or use
  22.    more than one key. }
  23.  
  24.    { Make sure that range check is off before you use any of these. }
  25.  
  26. procedure QuickSort  (var X:List; Less_Than:L_Less_Than_R; N:integer);
  27. {  A very fast sort, uses recursion.
  28.    May have stack problems on a large sort. }
  29.  
  30. procedure ShellSort  (var X:List; Less_Than:L_Less_Than_R; N:integer);
  31. {  Almost as fast as QuickSort, but without recursion.
  32.    The work horse of fast sorting methods. }
  33.  
  34. procedure LoopSort   (var X:List; Less_Than:L_Less_Than_R; N:integer);
  35. {  No reason to use this.  Included only for comparison. }
  36.  
  37. procedure BubbleSort (var X:List; Less_Than:L_Less_Than_R; N:integer);
  38. {  The only time to use this is when the array is almost in order, with
  39.    only a couple of items out of place. It may be useful to modify this
  40.    to make the sweep from the other end of the array.  BubbleSort is
  41.    a special purpose method.  Stick to QuickSort or ShellSort.}
  42.  
  43. (*---------------------------------------------------------------------*)
  44. implementation
  45. (*---------------------------------------------------------------------*)
  46. procedure Swap(var X:List;I,J:integer);
  47. var
  48.    Temp:Item;
  49.    begin
  50.       Temp:=X[I];
  51.       X[I]:=X[J];
  52.       X[J]:=Temp;
  53.    end;
  54. (*---------------------------------------------------------------------*)
  55. procedure Qsort(var X:List;Less_Than:L_Less_Than_R;Left,Right:integer);
  56. label
  57.    Again;
  58. var
  59.    Pivot:Item;
  60.    P,Q:integer;
  61.  
  62.    begin
  63.       P:=Left;
  64.       Q:=Right;
  65.       Pivot:=X [(Left+Right) div 2];
  66.  
  67.       while P<=Q do
  68.       begin
  69.          while Less_Than(X[P],Pivot) do inc(P);
  70.          while Less_Than(Pivot,X[Q]) do dec(Q);
  71.          if P>Q then goto Again;
  72.          Swap(X,P,Q);
  73.          inc(P);dec(Q);
  74.       end;
  75.  
  76.       Again:
  77.       if Left<Q  then Qsort(X,Less_Than,Left,Q);
  78.       if P<Right then Qsort(X,Less_Than,P,Right);
  79.    end;
  80.  
  81. (*---------------------------------------------------------------------*)
  82. procedure QuickSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
  83.    begin
  84.       Qsort(X,Less_Than,0,N-1);
  85.    end;
  86.  
  87. (*---------------------------------------------------------------------*)
  88. procedure ShellSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
  89. var
  90.    Gap,I,J:integer;
  91.  
  92.    begin
  93.       Gap:=N div 2;
  94.  
  95.       while Gap>0 do
  96.       begin
  97.          I:=Gap;
  98.  
  99.          while I<N do
  100.          begin
  101.             J:=I-Gap;
  102.  
  103.             while (J>=0) and (Less_Than(X[J+Gap],X[J])) do
  104.             begin
  105.                Swap(X,J,J+Gap);
  106.                dec(J,Gap);
  107.             end;
  108.  
  109.             inc(I);
  110.          end;
  111.  
  112.          Gap:=Gap div 2;
  113.       end;
  114.  
  115.    end;
  116.  
  117. (*---------------------------------------------------------------------*)
  118. procedure LoopSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
  119. var
  120.    I,J:integer;
  121.    begin
  122.       for I:=0 to N-1 do
  123.       begin
  124.          for J:=I+1 to N-1 do
  125.          begin
  126.             if Less_Than(X[J],X[I])
  127.             then
  128.             begin
  129.                Swap(X,I,J);
  130.             end;
  131.          end;
  132.       end;
  133.    end;
  134.  
  135. (*---------------------------------------------------------------------*)
  136. procedure BubbleSort(var X:List;Less_Than:L_Less_Than_R;N:integer);
  137. var
  138.    J:integer;
  139.    Finished:boolean;
  140.    begin
  141.       repeat
  142.          Finished:=true;
  143.          for J:=0 to N-2 do
  144.          if Less_Than(X[J+1],X[J]) then
  145.          begin
  146.             Finished:=false;
  147.             Swap(X,J,J+1);
  148.          end;
  149.       dec(N);
  150.       until Finished;
  151.    end;
  152.  
  153.    begin
  154.    end.
  155.  
  156.  
  157.